Attribute VB_Name = "modDownload"
Option Explicit

'Download a web page on the internet (works with proxy servers)
'
'The following routine uses API calls to read/download an internet file or an html page from a remote web site. The code will work with a proxy server and a routine demonstrating how to use this code can be found at the bottom of the post.

Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, sOptional As Any, ByVal lOptionalLength As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias _
    "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, _
    ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, _
    ByVal dwFlags As Long, ByVal dwContext As Long) As Long

'    hURL = InternetOpenUrl(hInternetSession, URL, vbNullString, 0, _
'        INTERNET_FLAG_RELOAD, 0)



'http://www.visualbasic.happycodings.com/Internet_Web_Mail_Stuff/code9.html
'Purpose     :  Get text from a web site
'Inputs      :  sServerName             The server name where the file is located eg.
'               sFileName               The file name to download eg. "index.asp" or "/code/codetoc.asp"
'               [sUsername]             If required, the login user name.
'               [sPassword]             If required, the user's password.
'               [lBufferSize]           The size of that the packets data downloaded in.
'Outputs     :  The contents of the specified file
'Notes       :  Can be used through a proxy server by specifying a username and password
'Revisions   :

Function CopyURLToFile(ByVal URL As String, Optional ByVal FileName As String) As String
    Dim hURL As Long
    Dim FileNum As Integer
    Dim ok As Boolean
    Dim NumberOfBytesRead As Long
    Dim Buffer As String
    Dim fileIsOpen As Boolean
    Dim bln404 As Boolean
    Dim strFile As String
    Dim lBufferSize As Long
    
    Dim hInternetSession As Long, hInternetConnect As Long, hHttpOpenRequest As Long
    Dim lRetVal As Long, lLenFile As Long, lNumberOfBytesRead As Long, lResLen As Long
    Dim sBuffer As String, lTotalBytesRead As Long
    
    Static blnDownloading As Boolean
    
    Const clBufferIncrement As Long = 2000, scUserAgent As String = "GH" & TXT_GHVER
    Const INTERNET_OPEN_TYPE_PRECONFIG = 0, INTERNET_FLAG_EXISTING_CONNECT = &H20000000
    Const INTERNET_OPEN_TYPE_DIRECT = 1, INTERNET_OPEN_TYPE_PROXY = 3
    Const INTERNET_DEFAULT_HTTP_PORT = 80, INTERNET_FLAG_RELOAD = &H80000000
    Const INTERNET_SERVICE_HTTP = 3
    Const HTTP_QUERY_CONTENT_LENGTH = 5
    
    On Error GoTo ErrorHandler
    
    If DetectGTA2version = False Then
        displaychat strChannel, strGHColor, "Download cancelled. Select your GTA2 folder in settings"
        Exit Function
    End If
    
    'If App.LogMode Then
        If Exists(App.Path & "\7za.exe") = False Then
            displaychat strChannel, strGHColor, "Download cancelled. Failed to find " & App.Path & "\7za.exe"
            Exit Function
        End If
    'End If
    
    frmGH.cmdCancel.Visible = True
    
    If blnDownloading = True Then
        displaychat strChannel, strGHColor, "A file is already being downloaded."
        Exit Function
    End If
    
    blnDownloading = True
    
    lBufferSize = -1
    
    If lBufferSize = -1 Then
        'Create an arbitary buffer to read the whole file in parts
        sBuffer = String$(clBufferIncrement, vbNullChar)
        lBufferSize = clBufferIncrement
    Else
        'Create a specified buffer size
        sBuffer = String$(lBufferSize, vbNullChar)
    End If
    
    'Initializes an application's use of the Win32 Internet functions
    hInternetSession = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)

    'Opens an FTP, Gopher, or HTTP session for a given site
    
    Dim sServerName As String, sUsername As String, sPassword As String, sFileName As String
    
    'remove http:// from URL
    If LCase$(Left$(URL, 7)) = "http://" Then
        sServerName = Right$(URL, Len(URL) - 7)
    Else
        sServerName = URL
    End If
    
    'Split URL into servername and filename
    Dim i As Integer
    i = InStr(sServerName, "/")
    If i Then
        sFileName = Mid$(sServerName, i, 666)
        sServerName = Left$(sServerName, i - 1)
    Else
        sFileName = "/"
    End If
    
    hInternetConnect = InternetConnect(hInternetSession, sServerName, INTERNET_DEFAULT_HTTP_PORT, sUsername, sPassword, INTERNET_SERVICE_HTTP, 0, 0)
    'Create an HTTP request handle
    hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "GET", sFileName, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
    
    'Creates a new HTTP request handle and stores the specified parameters in that handle

    lRetVal = HttpSendRequest(hHttpOpenRequest, vbNullString, 0, 0, 0)
    
    If lRetVal Then
        'Determine the file size
        lResLen = lBufferSize
        lRetVal = HttpQueryInfo(hHttpOpenRequest, HTTP_QUERY_CONTENT_LENGTH, ByVal sBuffer, lResLen, 0)
        
        If lRetVal Then
            'Successfully returned file length
            lLenFile = Val(Left$(sBuffer, lResLen))
            'Create a buffer to hold file
            sBuffer = String$(lLenFile, vbNullChar)
            lBufferSize = lLenFile
        Else
            'Unable to establish file length
            lLenFile = -1
        End If
    End If
        
    lBufferSize = 4096
    strFile = Right$(URL, Len(URL) - InStrRev(URL, "/"))
    
    If lLenFile <> -1 Then
        'ensure that there is no local file
        On Error Resume Next
    
        If FileName <> vbNullString Then Kill FileName
    
        'On Error GoTo ErrorHandler
            
        'open the local file
        FileNum = FreeFile
        Open FileName For Binary As FileNum
        fileIsOpen = True
    
       
        displaychat strChannel, strGHColor, "Downloading " & strFile
            
        'Read the file
        Do
            DoEvents
            If blnCancel = True Then Exit Do
            
            'Store the results
            lRetVal = InternetReadFile(hHttpOpenRequest, sBuffer, lBufferSize, lNumberOfBytesRead)
            
            lTotalBytesRead = lTotalBytesRead + lNumberOfBytesRead
            frmGH.Caption = "Game Hunter v" & TXT_GHVER & " - " & Int(lTotalBytesRead / 1000) & "kB/" & Int(lLenFile / 1000) & "kB at " & lngSpeed & "kB/s (" & Int((lTotalBytesRead / lLenFile) * 100) & "%)"
            lngDownloadSize = lTotalBytesRead
            
            If Left$(sBuffer, 2) = "<!" Then
                bln404 = True
                Exit Do
            End If
            
            'save the data to the local file
            Put #FileNum, , Left$(sBuffer, lNumberOfBytesRead)
            
            'Finished reading file
            If lNumberOfBytesRead = 0 Or lTotalBytesRead = lLenFile Or lRetVal = 0 Then
                Exit Do
            End If
        Loop
        
        frmGH.Caption = "Game Hunter v" & TXT_GHVER
       
        lTotalBytesRead = Int(lTotalBytesRead / 1000)
        If lngSpeed = 0 Then lngSpeed = lTotalBytesRead
    Else
        bln404 = True
    End If
    
    ' flow into the error handler

ErrorHandler:
    frmGH.cmdCancel.Visible = False
    lngDownloadSize = 0
    ' close the local file, if necessary
    If fileIsOpen Then Close #FileNum
    ' close internet handles, if necessary
    'If hURL Then InternetCloseHandle hURL
    'If hInternetSession Then InternetCloseHandle hInternetSession

    'Close handles
    InternetCloseHandle hHttpOpenRequest
    InternetCloseHandle hInternetSession
    InternetCloseHandle hInternetConnect
    blnDownloading = False

    ' report the error to the client, if there is one
    'If Err Then Err.Raise Err.Number, , Err.Description

    If bln404 = True Then
        If InStr(LCase(URL), "gtamp.com") Then
            displaychat strChannel, strGHColor, strFile & " isn't on gtamp.com. Check http://gta2dare.omnitude.net/maplist/download.php?mmp=" & LCase(Replace(strFile, " ", "%20")) & ".mmp"
            'displaychat strChannel, strGHColor, strFile & " isn't on gtamp.com. Check http://gta2dare.omnitude.net/maplist/list.php?type=any&string=" & LCase(Replace(strFile, " ", "%20"))
        Else
            displaychat strChannel, strGHColor, strFile & " is not at that address."
        End If
        Exit Function
    End If

    If blnCancel = True Then
        displaychat strChannel, strGHColor, "Download cancelled " & strFile & " - " & lTotalBytesRead & "kB at " & lngSpeed & "kB/s"
        blnCancel = False
    Else
        displaychat strChannel, strGHColor, "Download complete: " & strFile & " - " & lTotalBytesRead & "kB at " & lngSpeed & "kB/s."
        If InStr(GetCommandOutput(App.Path & "\7za.exe x -y -o" & vbQuote & strGTA2path & "data\" & vbQuote & " " & vbQuote & GetTmpPath & "gta2map.7z" & vbQuote, True, False, True), "Everything is Ok") Then
            displaychat frmGH.tabIRC.SelectedItem, strGHColor, "Map successfully installed."
        Else
            displaychat frmGH.tabIRC.SelectedItem, strGHColor, Replace(Replace(Replace(Replace(Replace(Replace(GetCommandOutput(App.Path & "\7za.exe x -y -o" & vbQuote & strGTA2path & "data\" & vbQuote & " " & vbQuote & GetTmpPath & "gta2map.7z" & vbQuote, True, False, True), "7-Zip (A) 9.20  Copyright (c) 1999-2010 Igor Pavlov  2010-11-18", vbNullString), vbNewLine, " "), "   ", vbNullString), "Extracting ", vbNullString), "  ", " "), "  ", " ")
            displaychat frmGH.tabIRC.SelectedItem, strGHColor, "Map failed to install."
        End If

    End If
End Function


